home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 41 / Amiga Format CD41 (1999-06)(Future Publishing)(GB)[!][issue 1999-07].iso / -readerstuff- / pete_sullivan / installme2nd / programs3 / -vcinstall- next >
Text File  |  1999-04-21  |  7KB  |  137 lines
  1. ; Generic LHA extractor, by Pete Sullivan
  2. ; $VER: SulliTech lha Extractor (1st September 1998)
  3. (complete 0)
  4. (set requiredKick 33)
  5. (set arcSize 25000)
  6. (set @default-dest "RAM:")
  7. (set level @user-level)
  8. (set finished 0)
  9. (set totalMem (+(dataBase "total-mem"))) ;get total free memory, AND, convert into a integer
  10. (set @app-name (substr (fileonly @icon) 0 (- (strlen (fileonly @icon)) 4)) ) ;get icon(archive) name minus the ".lha"
  11.  
  12. (if (= @app-name "Programs1") ((set requiredKick 37) (set arcSize 180000)) )
  13. (if (= @app-name "Programs2") ((set requiredKick 37) (set arcSize 110000)) )
  14. (if (= @app-name "Programs3") ((set requiredKick 37) (set arcSize 210000)) )
  15. (if (= @app-name "Programs4") ((set requiredKick 37) (set arcSize 130000)) )
  16.  
  17. (if (OR (= (getDevice @icon) "DF0") (= (getDevice @icon) "DF1") (= (getDevice @icon) "DF2"))
  18.     (set originalDisc (getAssign (getDevice @icon) "d")) )
  19.  
  20. (if (= requiredKick 37) (set Kickversion "2.04"))
  21. (if (= requiredKick 39) (set Kickversion "3.0"))
  22. (if (= requiredKick 40) (set Kickversion "3.1"))
  23.  
  24. (set hello            (cat "\n\n\nThis will extract the " @app-name" archive\nto your chosen location.\n\n\nSelect NOVICE to simply extract\n to RAM: or a floppy drive."))
  25. (set noDiscSpace      (cat "\n\n" @default-dest " has not enought space on it."))
  26. (set extractionError  (cat "\n\nOh dear something went wrong with lha.\n\nSource archive " ))
  27. (set lowMem           (cat "\nSorry you only have " totalMem " bytes of RAM,\nand you need " arcSize " bytes, to be able\nto extract " @app-name " into RAM:.\n\n\nTry removing some other applications,\nor use a blank floppy disc."))
  28. (set discRequest      (cat "\n\n\n\n\nPlease insert a (blank) disc into "))
  29. (set lowDiskSpace     (cat ": does not have enought room for " @app-name " to fit. You can either replace the current disk with another or I will format the current one."))
  30. (set removeCoverDisc  (cat "\n\n\n\n\nPlease remove the cover disc,\n\nand insert a (blank) disc in "))
  31. ;(set formatCheck      (cat  ", does not have enough room. You will have to format it.\n\nTo do this click on its icon, and then select 'Format Disk' from the Workbench menu.\nFormating a disc DESTROYS ALL the data on a disc.\nPress YES when done or NO to 
  32. (set deviceTooSmall   (cat " bytes,\nand so " @app-name " cannot fit onto it.\n\nTry using RAM:, or buy a hard drive.\n\n\n\n(You won't regret it;-)"))
  33. (set noRoom           (cat " bytes free, and\n\n" @app-name " needs " arcSize " bytes."))
  34. (set @askchoice-help  (cat "\n\nEach button represent a destination. You can select either to extract the program into RAM:, or onto a floppy disc using one of the drives.\n\nSimply press the appropriate button, then proceed."))
  35. (set wrongKick        (cat "\n\nWarning, you need at least Kickstart v" requiredKick " (" Kickversion ")\n\nto use " @app-name ".\n\n\nPress 'proceed' to continue anyway;\n\n\n\nBut you won't be able to run the program!"))
  36.  
  37. (if (getassign "DF1" "d") ;check for external disc drive, and set correct procedure
  38.   (procedure @noviceGetDest
  39.  
  40.     (set destination (cat (askchoice
  41.                         (prompt "Where do you want me to put " @app-name "?")
  42.                         (choices "RAM: {Recommended}")
  43.                         (help @askchoice-help)
  44.                        ) )
  45.     )
  46.   )
  47.   (procedure @noviceGetDest
  48.     (set destination (cat (askchoice
  49.                         (prompt "Where do you want me to put " @app-name "?")
  50.                         (choices "RAM: {Recommended}")
  51.                         (help @askchoice-help)
  52.                        ) )
  53.     )
  54.   )
  55. )
  56.  
  57. (procedure @getdefault-dest
  58.   (set destination (askdir
  59.                       (help @askdir-help)
  60.                       (prompt "Where Do you want " @app-name " extracting?")
  61.                       (newpath)
  62.                       (default @default-dest)
  63.                      )
  64.   )
  65.   (set @default-dest destination)
  66. )
  67.  
  68. (procedure @noviceUnArc ;handles quick extraction to ram or floppy
  69.   (if (= @default-dest 0)                                     ;if RAM
  70.     ( (set @default-dest "RAM:")
  71.       (if (> arcSize totalMem) (abort lowMem))
  72.     )
  73.     ( (set @default-dest (cat "DF" (- @default-dest 1) ":") ) ;else
  74.       (until (= finished 1)
  75.         (while (OR (=   (getAssign (getDevice @default-dest) "d") originalDisc) ;wait for new disc
  76.                    (NOT (getdiskspace @default-dest))
  77.                )
  78.           (if (= (getAssign (getDevice @default-dest) "d") originalDisc)
  79.               (message removeCoverDisc @default-dest)
  80.               (message discRequest @default-dest)
  81.           )
  82.         )
  83.         (if (> arcSize (getDiskSpace @default-dest)) ;check for room
  84.             ((if (askbool (prompt "\n\nSorry but the current disc in " @default-dest formatCheck) (help @askbool-help))
  85.               (set finished 0) (abort "Ok, try using RAM or formatting the disc before hand.")
  86.              )
  87.              (if (AND (<   (getDiskSpace @default-dest) arcSize)
  88.                       (NOT (= finished 1)) )
  89.                   (abort "\n\nSorry, but " @default-dest " can only store " (getDiskSpace @default-dest) deviceTooSmall)
  90.              )
  91.             )
  92.             (
  93.              (set finished 1)
  94.             )
  95.         )
  96.       )
  97.       (set @default-dest (getAssign (getDevice @default-dest) "d"))
  98.     )
  99.   )
  100. )
  101.  
  102. (procedure @expertUnArc
  103.   (if (AND (= (getDevice @default-dest) "RAM") (> arcSize totalMem))
  104.     (abort lowMem)
  105.     (if (AND (> arcSize (getDiskSpace @default-dest))
  106.              (NOT (= (getDevice @default-dest) "RAM")) )
  107.         (abort "\n\nSorry, but " @default-dest " only has\n" (getDiskSpace @default-dest) noRoom)
  108.     )
  109.   )
  110.   (if (> (run unArc) 0) (abort extractionError @icon "\n\nDestination path " @default-dest))
  111. )
  112.  
  113. ;*********************************************************************
  114.  
  115. (user 2)
  116.  
  117. (if  (< (/ (getversion) 65536) requiredKick)
  118.   (message wrongKick) )
  119.  
  120. (message hello)
  121. (user level)
  122. (welcome)
  123.  
  124. (if (= @user-level 0) ( (user 2) (@noviceGetDest) (set @default-dest destination) (@noviceUnArc) (user 0)))
  125. (@getdefault-dest)
  126. (user 2)
  127. (complete 10)
  128.  
  129. (if (NOT (= (substr @default-dest (- (strlen @default-dest) 1) 1) ":")) (set @default-dest (cat @default-dest "/")))
  130. (set unArc (cat "lha x -m -k -r -x \"" @icon "\" \"" @default-dest "\""))
  131. (working "\n\n\n\nExtracting " @app-name " to " @default-dest ",\n\nplease wait....")
  132. (@expertUnArc)
  133.  
  134. (complete 100)
  135. (message "Installation complete!\n\n\n\n\n" @app-name " has been successfully extracted,\nand can be found in " @default-dest ".\n\nHope it wasn't too painful!!")
  136. (exit (quiet))
  137.